unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Menus, Math;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    Restore1: TMenuItem;
    Clear1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Restore1Click(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure RestoreSpline(DataList: TList);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const dr = 3;
      dt = 1;

var List: Tlist;
    p: ^TPoint;
    T, Rx,Ry, Bminus,Bzero,Bplus, a,b,c,f, alfa,beta: array of Double;
    H: array of TPoint;
    N, x0,y0: Integer;
    B0,B1,B2,B3: Double;

procedure TForm1.FormCreate(Sender: TObject);
begin
  List:=TList.Create;
  Width := Screen.Width - 20;
  Canvas.Brush.Color := clRed;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Canvas.Ellipse(x-dr,y-dr,x+dr,y+dr);
  New(p);
  p^:=Point(x,y);
  List.Add(p);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  StatusBar1.Panels[0].Text:=Format('  (%d : %d)',[x,y])
end;

function Spl1 (t,t0,t1,t2,t3,t4:Single): Single;
begin
Result := (t-t0)/(t3-t0)*(t-t0)/(t2-t0)*(t-t0)/(t1-t0)
end;

function Spl2 (t,t0,t1,t2,t3,t4: Single): Single;
begin
Result := (t-t0)/(t3-t0)*(t-t0)/(t2-t0)*(t2-t)/(t2-t1)+
          (t-t0)/(t3-t0)*(t3-t)/(t3-t1)*(t-t1)/(t2-t1)+
          (t4-t)/(t4-t1)*(t-t1)/(t3-t1)*(t-t1)/(t2-t1)
end;

function Spl3 (t,t0,t1,t2,t3,t4: Single): Single;
begin
Result := (t4-t)/(t4-t1)*(t-t1)/(t3-t1)*(t3-t)/(t3-t2)+
          (t4-t)/(t4-t1)*(t4-t)/(t4-t2)*(t-t2)/(t3-t2)+
          (t-t0)/(t3-t0)*(t3-t)/(t3-t1)*(t3-t)/(t3-t2)
end;

function Spl4 (t,t0,t1,t2,t3,t4: Single): Single;
begin
Result := (t4-t)/(t4-t1)*(t4-t)/(t4-t2)*(t4-t)/(t4-t3)
end;

procedure Progonka(var ArrX: array of Double);
var i: Integer;
begin
  alfa:=nil;           beta:=nil;
  SetLength(alfa,N+2); SetLength(beta,N+2);
  alfa[0]:=-b[0]/c[0]; beta[0]:=f[0]/c[0];
  for i:=1 to N do begin
    alfa[i]:=-b[i]/(c[i]+alfa[i-1]*a[i]);
    beta[i]:=(f[i]-a[i]*beta[i-1])/(c[i]+alfa[i-1]*a[i])
  end;
  beta[N+1]:=(f[N+1]-a[N+1]*beta[N])/(c[N+1]+alfa[N]*a[N+1]);

  ArrX[N+1]:=beta[N+1];
  for i:=N downto 1 do ArrX[i]:=ArrX[i+1]*alfa[i]+beta[i];
  ArrX[0]:=-b[0]*ArrX[1]/c[0] + f[0]/c[0]
end;

procedure TForm1.RestoreSpline(DataList: TList);
var i: Integer;
    t0,t1: Double;
begin
  N := DataList.Count;

  H:=nil; SetLength(H,N);
  for i:=0 to N-1 do begin
    p:=DataList.Items[i];
    H[i]:=p^
  end;

  T:=nil; SetLength(T,N+6); T[3]:=0;
  for i:=4 to N+2 do T[i]:=T[i-1]+Hypot(H[i-3].x-H[i-4].x,H[i-3].y-H[i-4].y);
  T[2]:=-T[4]; T[1]:=-T[5]; T[0]:=-T[6];
  T[N+3]:=2*T[N+2]-T[N+1];
  T[N+4]:=2*T[N+3]-T[N+2];
  T[N+5]:=2*T[N+4]-T[N+3];

  for i:=0 to N+5 do T[i]:=i*i*i+1;

  Bminus:=nil;           Bzero:=nil;            Bplus:=nil;
  SetLength(Bminus,N+2); SetLength(Bzero, N+2); SetLength(Bplus, N+2);
  for i:=0 to N+1 do begin
    Bminus[i]:=(T[i+1]-T[i  ])/(T[i+3]-T[i  ])*(T[i+1]-T[i  ])/(T[i+2]-T[i  ]);
     Bzero[i]:=(T[i+4]-T[i+2])/(T[i+4]-T[i+1])*(T[i+2]-T[i+1])/(T[i+3]-T[i+1])+
               (T[i+2]-T[i  ])/(T[i+3]-T[i  ])*(T[i+3]-T[i+2])/(T[i+3]-T[i+1]);
     Bplus[i]:=(T[i+4]-T[i+3])/(T[i+4]-T[i+1])*(T[i+4]-T[i+3])/(T[i+4]-T[i+2])
  end;

  a:=nil;           c:=nil;           b:=nil;           f:=nil;
  SetLength(a,N+2); SetLength(c,N+2); SetLength(b,N+2); SetLength(f,N+2);
  c[0]:=1; c[N+1]:=1;
  for i:=1 to N do begin
    a[i]:=Bplus[i-1];
    c[i]:=Bzero[i];
    b[i]:=Bminus[i+1];
  end;

  Rx:=nil;           Ry:=nil;
  SetLength(Rx,N+2); SetLength(Ry,N+2);

  f[0]:=H[0].x; f[N+1]:=H[N-1].x; for i:=1 to N do f[i]:=H[i-1].x; Progonka(Rx);
  f[0]:=H[0].y; f[N+1]:=H[N-1].y; for i:=1 to N do f[i]:=H[i-1].y; Progonka(Ry);

  Canvas.MoveTo(H[0].x,H[0].y);
  for i:=3 to N+1 do begin
    t0:=T[i]; t1:=T[i+1];
    repeat
      B0:=Spl4(t0,T[i-3],T[i-2],T[i-1],T[i],T[i+1]);
      B1:=Spl3(t0,T[i-2],T[i-1],T[i],T[i+1],T[i+2]);
      B2:=Spl2(t0,T[i-1],T[i],T[i+1],T[i+2],T[i+3]);
      B3:=Spl1(t0,T[i],T[i+1],T[i+2],T[i+3],T[i+4]);

      x0:=Round(Rx[i-3]*B0+Rx[i-2]*B1+Rx[i-1]*B2+Rx[i]*B3);
      y0:=Round(Ry[i-3]*B0+Ry[i-2]*B1+Ry[i-1]*B2+Ry[i]*B3);
      Canvas.LineTo(x0,y0);
      t0:=t0+dt
    until t0 >= t1
  end;
end;

procedure TForm1.Restore1Click(Sender: TObject);
begin
  RestoreSpline(List);
end;

procedure TForm1.Clear1Click(Sender: TObject);
begin
  List.Clear;
  Canvas.Brush.Color:=clWhite;
  Canvas.FillRect(Canvas.ClipRect);
  Canvas.Brush.Color:=clRed;
end;

end.
